home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / manchest.lha / MANCHESTER / manchester / 2.2 / compact-structure.st < prev    next >
Text File  |  1993-07-24  |  6KB  |  210 lines
  1. "    NAME        compact-structure
  2.     AUTHOR        neild@cs.man.ac.uk
  3.     CONTRIBUTOR    neild@cs.man.ac.uk
  4.     FUNCTION      compact(er) structure copying
  5.     ST-VERSIONS    2.2
  6.     PREREQUISITES     structure-copying
  7.     CONFLICTS     
  8.     DISTRIBUTION    global
  9.     VERSION        1.1
  10.     DATE        27 Feb 1990
  11. SUMMARY    compact-structure
  12. The following classes and changes introduce CompactStructureOutputTable and
  13. CompactStructureInputTable. These classes can be used just like their super
  14. classes (those without the prefix Compact) but result in structure files
  15. that can be significantly smaller, 10 - 40% perhaps. Non compact structure
  16. files can be read by CompactStructureInputTable but compact files cannot be
  17. read by StructureInputTable.
  18. "!
  19. StructureInputTable variableSubclass: #CompactStructureInputTable
  20.     instanceVariableNames: 'classTable '
  21.     classVariableNames: ''
  22.     poolDictionaries: ''
  23.     category: 'System-Support'!
  24.  
  25. !CompactStructureInputTable methodsFor: 'structure reading'!
  26.  
  27. readClass
  28.  
  29.     | class |
  30.     stream next.
  31.     ^stream peek isDigit
  32.         ifTrue: [
  33.             class _ classTable at: (Integer readFrom: stream radix: 10).
  34.             stream next ~= $( ifTrue: [ self syntaxError ].
  35.             class ]
  36.         ifFalse: [
  37.             stream skip: -1.
  38.             class _ super readClass.
  39.             classTable at: classTable size + 1 put: class.
  40.             class ]! !
  41.  
  42. !CompactStructureInputTable methodsFor: 'initialize-release'!
  43.  
  44. initialize
  45.  
  46.     super initialize.
  47.     classTable _ IdentityDictionary new.! !
  48.  
  49. !CompactStructureInputTable methodsFor: 'adding'!
  50.  
  51. grow
  52.     "Must copy instance variables when growing"
  53.     | theClassTable |
  54.     theClassTable _ classTable.
  55.     super grow.    "does the grow & become"
  56.     classTable _ theClassTable! !
  57.  
  58. !CompactStructureInputTable methodsFor: 'private'!
  59.  
  60. rehash
  61.     "Must copy instance variables when rehashing"
  62.     | theClassTable |
  63.     theClassTable _ classTable.
  64.     super rehash.    "does the rehash & become"
  65.     classTable _ theClassTable! !
  66.  
  67.  
  68. StructureOutputTable variableSubclass: #CompactStructureOutputTable
  69.  
  70.     instanceVariableNames: 'classTable '
  71.     classVariableNames: ''
  72.     poolDictionaries: ''
  73.     category: 'System-Support'!
  74.  
  75. !CompactStructureOutputTable methodsFor: 'initialize-release'!
  76.  
  77. initialize
  78.  
  79.     super initialize.
  80.     classTable _ IdentityDictionary new.! !
  81.  
  82. !CompactStructureOutputTable methodsFor: 'id generation'!
  83.  
  84. putClassIdFor: anObject on: aStream
  85.     "If the class of anObject has not been seen before then print its name
  86.  onto
  87.     aStream and allocate it an integer unique within the classTable. If
  88.  its class is
  89.     already in the classTable then print the associated integer onto aStream."
  90.  
  91.  
  92.     (classTable at: anObject class ifAbsent: [
  93.         anObject class name printOn: aStream.
  94.         classTable at: anObject class put: classTable size + 1.
  95.         ^self ]) printOn: aStream base: 10! !
  96.  
  97. !CompactStructureOutputTable methodsFor: 'adding'!
  98.  
  99. grow
  100.     "Must copy instance variables when growing"
  101.     | theClassTable |
  102.     theClassTable _ classTable.
  103.     super grow.    "does the grow & become"
  104.     classTable _ theClassTable! !
  105.  
  106. !CompactStructureOutputTable methodsFor: 'private'!
  107.  
  108. rehash
  109.     "Must copy instance variables when rehashing"
  110.     | theClassTable |
  111.     theClassTable _ classTable.
  112.     super rehash.    "does the rehash & become"
  113.     classTable _ theClassTable! !
  114.  
  115. !Object methodsFor: 'public structure copying'!
  116.  
  117. storeCompactStructure
  118.     "Writes a (more compact) description of the receiver into a file, in
  119.  a way that allows
  120.      the object's structure to be reconstructed from the file's contents.
  121.  
  122.      Returns the file's name"
  123.  
  124.     | fileName file |
  125.     fileName _ (FileDirectory named: '')
  126.                     requestFileName: 'Structure file name?'
  127.                     default: (self class name, '.', self asOop printString, '.structure')
  128.  
  129.                     version: #any
  130.                     ifFail: [].
  131.     ^fileName ~~ nil
  132.         ifTrue: 
  133.             [
  134.             file _  FileStream fileNamed: (fileName ).
  135.             Cursor write showWhile: [self storeCompactStructureOn: file].
  136.             file close.
  137.             fileName]!
  138.  
  139. storeCompactStructureOn: aStream
  140.     "Writes a (more compact) description of the receiver onto aStream,
  141.  in a way that allows
  142.      the object's structure to be reconstructed from the stream's contents"
  143.  
  144.  
  145.     CompactStructureOutputTable storeStructureOf: self on: aStream! !
  146.  
  147. !Object methodsFor: 'structure copying'!
  148.  
  149. storeStructureOn: aStream structureTable: structureTable
  150.     "Stores the definition of an object onto aStream, given that the objects
  151.  
  152.      in structureTable have already been seen. This method is rarely overridden.
  153.  
  154.      The object's id number is written out followed by a letter identifying
  155.  its form
  156.      of definition and its class name, followed by a pair of parentheses
  157.  enclosing
  158.      its definition.
  159.      This scheme is closely based upon Steve Vegdahl's work presented in
  160.  
  161.      Moving Structures between Smalltalk Images, OOPSLA '86"
  162.  
  163.     structureTable
  164.         putIdOf: self
  165.         on: aStream
  166.         ifNew: [
  167.             self isUniqueValue
  168.                 ifTrue: [aStream nextPut: $U; nextPutAll: self class name.
  169.                         ^self].
  170.             structureTable if: self isGlobal: [:expr|
  171.                     aStream nextPutAll: 'G<'; nextPutAll: expr; nextPut: $>.
  172.                     ^self].
  173.             aStream nextPut: $C.
  174.             structureTable putClassIdFor: self on: aStream.
  175.             aStream nextPut: $(.
  176.             self storeDefinitionOn: aStream structureTable: structureTable.
  177.             aStream nextPut: $)]! !
  178.  
  179. !StructureOutputTable methodsFor: 'id generation'!
  180.  
  181. putClassIdFor: anObject on: aStream
  182.     "Print the name of aClass onto aStream."
  183.  
  184.     anObject class name printOn: aStream.! !
  185.  
  186. !StructureInputTable methodsFor: 'structure reading'!
  187.  
  188. readClass
  189.  
  190.     stream next.
  191.     ^Smalltalk at: (stream upTo: $() asSymbol! !
  192.  
  193. !StructureInputTable methodsFor: 'As yet unclassified'!
  194.  
  195. readClassAndDefinition
  196.     | obj class varCount |
  197.     Cursor execute showWhile: [
  198.         class _ self readClass.
  199.         obj _ (stream peek = $-
  200.                     ifTrue: [stream skip: 1. class basicNew]
  201.                     ifFalse: [varCount _ Integer readFrom: stream radix: 10.
  202.                         varCount == 0 ifTrue: [class basicNew]
  203.                         ifFalse: [class basicNew: varCount]]).
  204.         stream skip: 1.
  205.         self at: currentId put: obj].
  206.     obj readStructureFrom: stream structureTable: self.
  207.     ^obj! !
  208.  
  209.  
  210.